perm filename NOTSUB.F4[RST,LCS] blob sn#207686 filedate 1976-03-23 generic text, type T, neo UTF8
00010	C**********   FOR NOTE DRAWING, RESTS ACCENT AND OTHER MARKS.
00100		SUBROUTINE NOTWRT
00200		IMPLICIT INTEGER(A-Q,S-Z)
00300		COMMON/DL/IXRX,M,AA /FONT/JFONT 
00400		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00600		COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
00700		REAL DIS,CENTR,POS,STFF
00800		COMMON /STF/RSTFAC(-3/4),RSTJ2
00900		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01000		COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
01110	C  ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
01200		COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01300		1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,J5X,RXX,JJJ,
01400		1 PUNCT,JY,RJ
01500		EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01600		1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
01700		1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(STEM,JQ(20))
01800		1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
01850		1,(RX4,JQ(19)),(J5X,RZTM)
01900		DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
02000		1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
02100		1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
02200		1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
02300		1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
02400		1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008,
02500		1 65.,1106.104, 0.002, 6.104, 12.002, 18.104, 24.002, 24.003,
02600		1 18.103, 12.003, 6.103, 0.003, 106.103/
02700	     1 ,RNOTE/ 1000., 5.007, 11.007, 16., 11.107, 5.107, 0.0,
02800	     1 1000.0, 7.007, 14.0, 7.107, 0,  1000.107, 14.007,
02900	     1 1014.107,0.007, 1000.003,4.107,6.007,9.107,11.007,14.103/
03000		DATA RDOT/1000.101, .102, 1.103, 2.103, 3.102, 3.101, 2., 1.,
03050		1 .101, 2.103, 2., .102, 3.102, 1., 1.103, 3.101, .102/
03100		1 ,RSTM/14.54/
03200		1 ,XAC/9,14,18,28,33,44,53/
03300	C   ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
03400		DATA RACCI/6.0,1115.003, 110.007, 106.001,
03500	     1 115.109, 115.021, 15.0, 1104.104, 118.108,
03600	     1 1108.113, 108.016,  1104.008, 118.004,
03700	     1 1114.014, 114.115, 22.0,1106.117, 106.007, 114.004
03800	     1, 1114.018, 114.107, 106.104/
03900	     1 ,NACCI/1,7,16/
04000	
04100		RST7=7.*RSTJ2
04200		RST3=3.*RSTJ2
04300		RSTX=RSTJ2
04400	C  FOR MINIS AT 245
04500		RMINI=RSTJ2
04600	C  OR SHOULD THIS ONLY BE IN NOTES, ETC?  15/9/72
04700	
04800		RINV=1
04810		RX4=R4
04900		IF(JA.EQ.1)GO TO 11
05000		IF(JA.EQ.9)GO TO 242
05100	
05200	C  NEXT IS FOR RESTS
05210		IF(IABS(J4).LT.480)GO TO 302
05220	C  P4+500= USER-ADDED RESTS
05230		CALL EXTRA
05240		RETURN
05300	302	IF(R8.NE.0)J5=-2
05400	C  R8 PUTS NUMBER OVER WHOLE REST ONLY.
05500		IF(J5.GT.1)R4=R4-2
05600	CC	RA=R4
05700		R7=R6*10.
05800	C  FOR DOTS
05850		IF(J5.GE.2)R3=R3-3.0*RSTJ2
05875	C SHIFTS 1/16 AND SMALLER RESTS .5 TO LEFT
05900	202	CALL REST
06000		IF(J5.GT.1)GO TO 200
06100		IF(R7.EQ.0)RETURN
06200	201	RA=14
06300		R6=0
06400		IF(J5)RA=19
06500		R3=R3+RA*RSTJ2
06600		R4=8.+R4
06700		JA=9
06800		J5=7
06900	C   IF P6=1 THE REST IS DOTTED
07000		CALL CENTX
07100		GO TO 242
07200	200	J5=J5-1
07300	C  FOR MULTIPLE TAILS ON 16TH REST, ETC.
07400		R4=R4+2.
07500		CALL RJBX(4.3)
07600		GO TO 202
07700	
07800	29	RJX=R3
07900		RJY=CENTR+RSTJ2
08000	108	IF(WHOLE.NE.0)RJX=RJX+3.*RMINI
08100	C WHOLE=1 MEANS IT'S A WHOLE NOTE (WIDER THAN A HALF.)
08200		WHOLE=0
08210		RG=9
08220		IF(PLT)RG=17
08230	C  DOESN'T FILL DOT ON DPY
08300	107	CALL RDRAW(1,RG,RDOT,RMINI,RJX,RJY,RMINI)
08400	C    ****   ****    ***  ↑↑↑↑↑↑↑↑↑↑ THESE WERE RSTJ2 11/74
08500		IF(JA.EQ.1)GO TO 290
08600		IF(R7.GE.20.)GO TO 290
08700		RB=POS+52.*RSTJ2
08800		IF(RJY.NE.RB)GO TO 6241
08900	C   WHERE IS RB USED LATER?
09000		RJY=RJY-12*RSTJ2
09100		GO TO 107
09200	C  ABOVE FOR DOTS
09300	290	R7=R7-10.
09400		IF(R7.LT.10.)GO TO 1342
09500		RJX=RJX+RSTJ2*10.
09600		GO TO 107
09700	
10000	C  NOTES****
10200	11	CALL NTS
10300		IF(STEM)RETURN
10400		R4=RX4
23500	
31500	1242	IF(R7.LT.10.)GO TO 1342
31600	C  FOR DOTTED NOTE-- P7>9 
31700		RJX=RJAC+(22.+AMOD(R7,1.0)*59.6)*RMINI
31800	C***↑↑↑↑↑  WAS 24.  11/74
31900		RJY=CENTR+RSTJ2
32000		IF(JY.EQ.10)GO TO 4322
32100	 	IF(JY.NE.30)GO TO 3322
32200	4322	RJX=RJX+RSTM
32300	C  MOVES DOT TO LEFT
32400	3322	IF(MOD(J4,2).EQ.0)GO TO 108
32500		RX=RST7
32600		IF(JY.GE.20)RX=-RX
32700	3342	RJY=RJY+RX
32800		GO TO 108
32900	C  JY=30= STEM UP, INTERVAL OF SECOND.
33000	1342	IF(J5.NE.0)GO TO 5322
33100		IF(R6.EQ.0)RETURN
33200	5322	R3=R3-R5*59.6*RMINI
33300	C  TO SPACE OUT ACCIDS.
33400	CCXX	IF(RMINI.NE.RSTJ2)RSTJ2=.7*RSTJ2
33500	C   ↑↑↑↑		  ↑↑↑↑↑ WAS RMINI
33600	C********* 18/9/72
33700	242	IF(J5.GE.0)GO TO 2421
33800		RINV=-RINV
33900		J5=-J5
34000	C  NOW THAT 0 IS NOT USED FOR DOTS THE ABOVE 3 LINES COULD BE CHNGD
34100	C********** LAST # WAS 281?
34200	C b,#,NAT, ACC ∧, ACC >, FERMATA, DOT, REP MEAS., DASH
34300	CXX 11/74 2421	RH=14
34400	2421	J5X=-1
34500		JAX=JA
34600	C  USED AT 4241  FOR DOUBLE MARKS ON NOTES.
34700		IF(JA.EQ.9)GO TO 2423
34800		IF(J5.GT.3)GO TO 3121
34900	C  DBL FLT(4) AND DBL SHRP(5)  ALWAYS USE 'DRAW' ROUTINE.
35000		GO TO 211
35100	2423	RJZ=R4
35200	C  FOR 'DRWNT' WHEN PLOTTING.
35300		CALL NOZERO(R6)
35400	C  R6=SIZE FACTOR  (P6)
35500		RMINI=RMINI*R6
35600		R6=0
35700		STEM=0
35800	C   FOR MISC. ITEMS
35900	210	IF(IABS(J4).LT.100)GO TO 1241
36000	CC210	IF(IABS(J4).LT.100)GO TO 3241
36100		J4=MOD(J4,100)
36200		RMINI=.7*RMINI
36300	CC3421	J5X=-1
36400	C FOR 2 MARKS AT ONCE.
36500	1241	IF(J5.GE.11)GO TO 28
36600		GO TO (211,211,211,28,28,222,249,60,27,27),J5
36700		RETURN
36800	C  ERROR TRAP (I.E. J5=0)
36900	C  FOR 1 OR 2 BAR REP SIGNS.
37000	60	CALL BREP
37100		RETURN
37200	
37300	241	CALL LINES(R3,CENTR,3)
37400		GO TO 210
37500	
37600	
37700	211	IF(J5.EQ.0)GO TO 2422
37800	C  GETS BACK GOOD VERTICAL POS.
37900		IF(J5.GT.3)GO TO 222
38000	C  FOR 2-PASS PLOTTING (-2=THIN LINES, -3=HEAVY LINES)
38100		IF(PLT)GO TO 3121
38200		IF(JFONT.NE.0)GO TO 3121
38300		X=NACCI(J5)
38400		CALL RDRAW(X+1,RACCI(X),RACCI,RMINI,R3,CENTR,RMINI)
38500	2422	IF(R6.EQ.0)RETURN
38600		J5=(R6+.001)*100.
38700		R4=RX4
38800	CC	R4=RJZ
38900		R3=RJAC
39000	1249	IF(MOD(J5,10).GT.3)GO TO 249
39100		J5=J5/10
39200		IF(J5.GT.30)GO TO 1249
39300	C WHEN P1=1, EXTRACTS ACCENT NUMBERS FROM DECIMALS IN P6.
39400	249	IF(J5.GT.30)GO TO 28
39500		IF(J5.GT.10)GO TO 246
39600		IF(J5.EQ.0)RETURN
39700		IF(JA.NE.1)GO TO 250
39800	CXX 11/74	RH=8
39900		RB=14.
40000		IF(MOD(J4,2).EQ.0)GO TO 244
40100		IF(J5.EQ.7)GO TO 6322
40200		IF(J5.NE.9)GO TO 244
40300	6322	IF(STEM.GT.1)GO TO 7322
40400		IF(J4.LT.5)GO TO 244
40500	7322	IF(J4.LE.9)GO TO 8322
40600		IF(STEM.EQ.2)GO TO 244
40700		IF(STEM.EQ.0)GO TO 244
40800	8322	RB=21
40900	C   PUTS ACCENT DOWN OR UP 1 SPACE. AVOIDS PUTTING DOT OR DASH ON LINE
41000	244	IF(STEM.EQ.1)GO TO 9322
41100		IF(STEM.NE.0)GO TO 245
41200		IF(J4.GE.7)GO TO 245
41300	9322	RB=-RB
41400	CC	IF(J5.NE.6)GO TO 245
41500	CC	IF(J4.LT.9.AND.STEM.EQ.2)GO TO 281
41600	CC	IF(J4.GT.4.AND.STEM.EQ.1)GO TO 252
41700	245	CENTR=CENTR+RB*RSTX
41800	250	IF(J5.GT.10)GO TO 281
41900		IF(J5.LT.6)GO TO 281
42000		JA=9
42100		IF(J5.NE.7)GO TO 253
42200	C   7=DOT
42300		RXX=R3
42400		R3=R3+6.7*RMINI
42500	C  CENTERS THE DOT
42600		GO TO 29
42700	253	IF(J5.EQ.9)GO TO 271
42800	C   9=DASH
42900	251	IF(RB.LT.0)RINV=-RINV
43000	C   FIX THIS!!!!  FOR BOWINGS, ETC.
43100	2222	IF(J5.NE.20)GO TO 2223
43200	CZZZZZZZZZZZ
43300		JA=7
43400		R5=0
43500		J7=1
43600		CALL ALPHA
43700	C  FOR TRILL  -- J5=20
43800		RETURN
43900	2223	IF(J5.EQ.17)GO TO 323
44000		IF(J5.NE.18)GO TO 222
44100	323	RINV=J5
44200	C  FOR MORD, INV.MORD
44300	222	CALL FERMTA
44400		GO TO 5241
44500	252	RX=POS
44600	248	CENTR=RX
44700		GO TO 251
44800	246	IF(J5.LT.10)GO TO 245
44900	CC	R4=R4+3
45000	CC	IF(STEM.EQ.1)R4=R4+6.+R8
45020		RZ=3
45040		IF(STEM.EQ.1)RZ=9+R8
45060		R4=R4+RZ*RMINI/RSTJ2
45100		IF(R4.LT.12.5)R4=12.5
45200		CALL CENTX
45300		IF(J5.EQ.26)GO TO 222
45400	C  26 IS NEW NUMB FOR FERMATA.
45500	28	IF(J5.LT.30)GO TO 281
45600		J5X=MOD(J5,10)
45700	C  J5X SAVES NEXT MARK.
45800		IF(J5X.LT.4)J5X=0
45900		J5=J5/10
46000		IF(J5.GT.30)RETURN
46100	C  WON'T READ 415 ETC. (CORRECT=154)
46200	C DOES BOTTOM MARK FIRST, THEN TOP.
46300		CALL EXCH(J5X,J5)
46400	C  PUTS UPBOW, DNBOW, ETC. ABOVE STACC., ETC.
46500		IF(JA.EQ.1)GO TO 249
46600		GO TO 1241
46700	281	X=1
46800		IF(J5.GT.16)GO TO 2222
46900	C  JUMP FOR MORD, INV.MORD, TRILL
47000		IF(J5.NE.4)GO TO 228
47100		X=5
47200		CALL RJBX(.5)
47300		GO TO 328
47400	228	IF(J5.GT.10)X=XAC(J5-10)
47500	C   X IS POINTER IN RACNT ARRAY
47600	328	RA=RMINI
47700	C   OR RSTJ2?
47800		IF(RINV.LT.0)GO TO 1323
47900		IF(STEM.NE.1)GO TO 2323
48000		IF(J5.NE.4)GO TO 2323
48100	1323	RA=-RA
48200	C  ↓↓↓ X ↓↓↓ PICKS UP TYPO ERRORS
48300	2323	IF(X.LT.54)CALL RDRAW(X+1,RACNT(X),RACNT,RA,R3,CENTR,RMINI)
48400	C              PTR, WDCNT, ARRAY,Y MULT,HOR ADD,VERT ADD, X,Y,MULT
48500	C  IN ARRAY, 33.012 WOULD BE X=33, Y=12.  101.123 IS X=-1, Y=-23.
48600		GO TO 5241
48700	4241	JJJ=J5
48800		J5=J5X
48900		J5X=-1
49000		IF(JAX.NE.1)GO TO 7241
49100		IF(J5.GT.10)GO TO 246
49200		IF(J5.NE.7)GO TO 7241
49300		IF(JJJ.NE.9)GO TO 249
49400	7241	RXX=8.5*RMINI
49500	C↑↑↑↑↑↑  11/74  WAS RH*
49600		IF(STEM.EQ.1)RXX=-RXX
49700		CENTR=CENTR+RXX
49800		IF(J5.EQ.26)J5=6
49900	C  TEMPORARY?? FIX
50000		GO TO 1241
50100	C >=5,  ∧=4
50200	27	R3=J3
50300	C  DASHES
50400	271	CALL LINX(R3,CENTR,R3+RMINI*14.,CENTR)
50500	C    ****   ****    ***  ↑↑↑↑↑↑↑↑↑↑ THIS WAS RSTJ2 11/74
50600	5241	IF(J5X.GT.0)GO TO 4241
50700	C J5X IS FOR DOUBLE MARKS.  (WHAT ABOUT DOT POSITION.)
50800		RETURN
50900	6241	R3=RXX
51000	C  RESET R3 AFTER A DOT.
51100		GO TO 5241
51200	3121	J5=J5+9
51300	C  SOON WILL HAVE DBL FLAT (4) AND DBL SHRP (5)
51400	C  TO DRAW GOOD ACCIS ON PLOTTER - NOT ON DPY.(IN CLEF4.DMD)
51500		CALL DRWNT
51600		GO TO 2422
51700		END